home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PASCALL / CLOCKIN / GRAPHIN2.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-12-20  |  3.7 KB  |  157 lines
  1. unit graphin2;
  2. interface
  3. uses
  4.      graph,crt;
  5. type
  6.      timing=(hr,min,sec,hndthsec);
  7. const
  8.      gap=1;
  9.      backcolor=0;
  10.      gapcolor=white;
  11.  
  12.      hrhandcolor=5;
  13.      minhandcolor=4;
  14.      sechandcolor=3;
  15.      hndthsechandcolor=2;
  16.  
  17.      centerx=319;
  18.      centery=239;
  19.  
  20.      hrhandsize=71;
  21.      minhandsize=121;
  22.      sechandsize=171;
  23.      hndthsechandsize=221;
  24.  
  25.      hrhandnumber=24;
  26.      minhandnumber=60;
  27.      sechandnumber=60;
  28.      hndthsechandnumber=100;
  29.  
  30. procedure setupgraph;
  31. procedure setupgrid;
  32.  
  33. function incrementsize(hand:timing):real;
  34. procedure puthand(lasthandposition,handposition:word;  hand:timing);
  35.  
  36. function handcolor(hand:timing):integer;
  37. function handsize(hand:timing):integer;
  38.  
  39. procedure beep;
  40. function streng(num:word):string;
  41.  
  42.  
  43.  
  44. implementation
  45.  
  46. function streng(num:word):string;
  47. var
  48.       strenged:string;
  49. begin
  50.      str(num,strenged);
  51.      streng:=strenged;
  52. end;
  53.  
  54. procedure beep;
  55. begin
  56.      sound(200);
  57.      delay(1);
  58.      nosound;
  59. end;
  60.  
  61.  
  62. function handcolor(hand:timing):integer;
  63. begin
  64.      case hand of
  65.           hr: handcolor:=hrhandcolor;
  66.           min: handcolor:=minhandcolor;
  67.           sec: handcolor:=sechandcolor;
  68.           hndthsec: handcolor:=hndthsechandcolor;
  69.      end;
  70. end;
  71.  
  72. function handsize(hand:timing):integer;
  73. begin
  74.      case hand of
  75.           hr: handsize:=hrhandsize;
  76.           min: handsize:=minhandsize;
  77.           sec: handsize:=sechandsize;
  78.           hndthsec: handsize:=hndthsechandsize;
  79.      end;
  80. end;
  81.  
  82. function incrementsize(hand:timing):real;
  83. begin
  84.      case hand of
  85.           hr: incrementsize:=360/hrhandnumber;
  86.           min: incrementsize:=360/minhandnumber;
  87.           sec: incrementsize:=360/minhandnumber;
  88.           hndthsec: incrementsize:=360/hndthsechandnumber;
  89.      end;
  90. end;
  91.  
  92. procedure puthand(lasthandposition,handposition:word;  hand:timing);
  93. var
  94.      angl:integer;
  95. begin
  96.      setcolor(handcolor(hand));
  97.      angl:=round(450-(incrementsize(hand)/2)-(incrementsize(hand)*handposition));
  98.      arc(centerx,centery,angl+gap,round(angl-gap+incrementsize(hand)),handsize(hand));
  99.  
  100.      setcolor(backcolor);
  101.      angl:=round(450-(incrementsize(hand)/2)-(incrementsize(hand)*(lasthandposition)));
  102.      arc(centerx,centery,angl+gap,round(angl-gap+incrementsize(hand)),handsize(hand));
  103. end;
  104.  
  105.  
  106. procedure setupgraph;
  107. var
  108.      Gd, Gm: Integer;
  109. begin
  110.      Gd:=VGA;
  111.      Gm:=vgaHI;
  112.      InitGraph(Gd,Gm,'c:\tp\bgi');
  113.      if GraphResult<>grOk then halt;
  114.      cleardevice;
  115. end;
  116.  
  117. function handnumber(hand:timing):integer;
  118. begin
  119.      case hand of
  120.           hr: handnumber:=hrhandnumber;
  121.           min: handnumber:=minhandnumber;
  122.           sec: handnumber:=sechandnumber;
  123.           hndthsec: handnumber:=hndthsechandnumber;
  124.      end;
  125. end;
  126.  
  127. procedure setupgrid;
  128. var
  129.      hand:timing;
  130.      handposition,angl:integer;
  131.      oldpattern:fillpatterntype;
  132.      arccoords:arccoordstype;
  133. begin
  134.      getfillpattern(oldpattern);
  135.      setfillpattern(oldpattern,backcolor);
  136.      bar(0,0,getmaxx,getmaxy);
  137.      setcolor(gapcolor);
  138.      for hand:=hr to hndthsec do
  139.      begin
  140.           for handposition:=1 to handnumber(hand) do
  141.           begin
  142.                setcolor(backcolor);
  143.                angl:=round(450-(incrementsize(hand)*handposition));
  144.                arc(centerx,centery,angl-1,angl+1,(handsize(hand)+15));
  145.                getarccoords(arccoords);
  146.  
  147.                setcolor(gapcolor);
  148.                outtextxy(arccoords.xstart-5,arccoords.ystart-3,streng(handposition));
  149.  
  150.                angl:=round(450-(incrementsize(hand)/2)-(incrementsize(hand)*handposition));
  151.                arc(centerx,centery,angl-gap,angl+gap,handsize(hand));
  152.           end;
  153.      end;
  154. end;
  155.  
  156. begin
  157. end.